Clustering

¿Hay alguna forma de agrupar los paises en base a la tasa de suicidio?

Importamos las librerías que son necesarias:

library(tidyr)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(cluster)
library(factoextra)

## Loading required package: ggplot2

## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa

library(ggplot2)
library(plotly)

## 
## Attaching package: 'plotly'

## The following object is masked from 'package:ggplot2':
## 
##     last_plot

## The following object is masked from 'package:stats':
## 
##     filter

## The following object is masked from 'package:graphics':
## 
##     layout

library(countrycode)
library(reshape2)

## 
## Attaching package: 'reshape2'

## The following object is masked from 'package:tidyr':
## 
##     smiths

Lectura y preprocesado del dataset

suicidios <- read.csv("data/1.OMSTasaMortalidadSuicidio/tasa_suicidio_por_pais.csv")

Este archivo CSV contiene los datos de las tasa de suicidio de cada país desde el 2000 hasta el 2019. Previo a esta lectura, ya que es un dataset que se ha usado para las preguntas grupales, se ha realizado un preprocesado, que básicamente consistía en eliminar diferentes columnas que no nos aportaban valor para nuestros experimentos.

Los atributos que contiene este dataset son:

• GEO_NAME_SHORT: nombre de cada país.

• DIM_TIME: año.

• DIM_SEX: subgrupo del país según el sexo. (Total, Male, Female)

• VALUE_NUMERIC: tasa de suicidio por cada 100.000 habitantes.

A pesar de que ya ha sido preprocesado, para esta pregunta, es necesario realizar otro preprocesamiento, que consiste básicamente que añadir, para cada muestra, las columnas TOTAL, MALE y FEMALE, que contienen la tasa de suicidios para cada país en ese año del total del paías, de los hombres y de las mujeres.

Preprocesado

Como he comentado, voy a modificar el dataset para que los datos de las tasas de suicidios de cada subgrupo se encuentren como columnas para cada muestra, para ello hago uso de la librería dplyr, que manipula el conjunto de datos. Convierte la variable DIM_SEX en atributos específicos, realiza un pivote ancho y selecciona columnas clave (GEO_NAME_SHORT, DIM_TIME, TOTAL, MALE, FEMALE)

df_suicidios <- suicidios %>%
  mutate(DIM_SEX = factor(DIM_SEX, levels = c("Total", "Male", "Female"))) %>%
  pivot_wider(names_from = DIM_SEX, values_from = VALUE_NUMERIC) %>%
  select(GEO_NAME_SHORT, DIM_TIME, Total, Male, Female)

## Warning: Values from `VALUE_NUMERIC` are not uniquely identified; output will contain
## list-cols.
## • Use `values_fn = list` to suppress this warning.
## • Use `values_fn = {summary_fun}` to summarise duplicates.
## • Use the following dplyr code to identify duplicates.
##   {data} %>%
##   dplyr::group_by(GEO_NAME_SHORT, DIM_TIME, DIM_SEX) %>%
##   dplyr::summarise(n = dplyr::n(), .groups = "drop") %>%
##   dplyr::filter(n > 1L)

Una vez realizada esta transformación del dataset, compruebo que no tiene valores ausentes.

num_valores_faltantes <- colSums(is.na(df_suicidios))

# Muestra el resultado
print(num_valores_faltantes)

## GEO_NAME_SHORT       DIM_TIME          Total           Male         Female 
##              0              0              0              0              0

El siguiente paso es convertir los valores a tipo numérico, ya que al realizar la transformación son de tipo lista y dan problemas al realizar los siguientes pasos.

Para ello, hago uso de la función sapply, que para cada elemento de las columnas Total, Male y Female, extrae el primer elemento de la lista (que es el valor de esa muestra) y posteriorente se transforma en tipo numérico.

También, creo un nuevo dataframe (df_procesado), en el que agrupo las muestras por pais y calculo la media para Total, Male y Female, ya que me parece más interesante hacer el clustering de esta manera que introduciendo el año.

# Extraer el primer elemento de cada lista en la columna Total
df_suicidios$Total <- sapply(df_suicidios$Total, function(x) x[1])
df_suicidios$Male <- sapply(df_suicidios$Male, function(x) x[1])
df_suicidios$Female <- sapply(df_suicidios$Female, function(x) x[1])

# Asegúrate de que las columnas relevantes sean de tipo numérico
df_suicidios$Total <- as.numeric(df_suicidios$Total)
df_suicidios$Male <- as.numeric(df_suicidios$Male)
df_suicidios$Female <- as.numeric(df_suicidios$Female)


df_procesado<- df_suicidios %>%
  group_by(GEO_NAME_SHORT) %>%
  summarise(
    Total = mean(Total),
    Male = mean(Male),
    Female = mean(Female)
  )

head(df_procesado)

## # A tibble: 6 × 4
##   GEO_NAME_SHORT Total  Male Female
##   <chr>          <dbl> <dbl>  <dbl>
## 1 Afghanistan     4.68  5.06   3.98
## 2 Africa          8.05 12.0    4.16
## 3 Albania         5.86  7.47   4.46
## 4 Algeria         3.35  4.22   2.47
## 5 Americas        8.48 13.3    3.81
## 6 Angola          7.21 12.1    3.19

CLUSTERING

Una vez realizado todo el preprocesado necesario, pasamos a realizar el clustering, para ello haré uso del algortimo k-means.

Primero, creo otro dataset que contiene los datos necesarios para el clustering, en este caso todos menos el nombre del pais.

# Luego, puedes proceder con la creación de datos_clustering
datos_clustering <- df_procesado[, c("Male", "Female", "Total")]

Posteriormente, sobre este conjunto de datos aplico el método del codo, con el objetivo de saber cual es el número óptimo de clusters.

# Calcula la suma de cuadrados dentro (WSS) para diferentes números de clusters
wss <- c()
for (i in 1:10) {
  kmeans_model <- kmeans(datos_clustering, centers = i, nstart = 20)
  wss[i] <- kmeans_model$tot.withinss
}

# Grafica la suma de cuadrados dentro en función del número de clusters
plot(1:10, wss, type = "b", pch = 19, frame = FALSE, 
     xlab = "Número de Clusters", ylab = "Suma de Cuadrados Dentro (WSS)",
     main = "Método del Codo")

# Agrega líneas y etiquetas
abline(v = which.min(wss), col = "red", lty = 2)
text(which.min(wss), min(wss), "Punto de Codo", pos = 1, col = "red")

Como se puede apreciar en el gráfico, el número optimo sería 3, ya que hacer uso de más clusters no se refleja en una mejor significativa, por lo que me dispongo a realizar clustering con 3 grupos.

Ejecuto el algoritmo, y añado una columna más al dataframe df_procesado, la cual indica el cluster al que pertenece esa muestra.

set.seed(123)  # Para reproducibilidad
kmeans_result <- kmeans(datos_clustering, centers = 3, nstart = 20)

# Añade la información del cluster al conjunto de datos original
df_procesado$Cluster <- as.factor(kmeans_result$cluster)

# Muestra el resultado
head(df_procesado)

## # A tibble: 6 × 5
##   GEO_NAME_SHORT Total  Male Female Cluster
##   <chr>          <dbl> <dbl>  <dbl> <fct>  
## 1 Afghanistan     4.68  5.06   3.98 2      
## 2 Africa          8.05 12.0    4.16 2      
## 3 Albania         5.86  7.47   4.46 2      
## 4 Algeria         3.35  4.22   2.47 2      
## 5 Americas        8.48 13.3    3.81 2      
## 6 Angola          7.21 12.1    3.19 2

fviz_cluster(kmeans_result, geom = "point", data = datos_clustering, title = "Clustering de Tasa de Suicidios y Gasto en Salud")

## Warning: argument title is deprecated; please use main instead.

En esta gráfica se observan las fronteras de cada cluster, se puede observar que hay dos que son algo más parecidos (2 y 3) y que hay uno que está completamente separado de los demás (1).

VISUALIZACIONES

Gráfico de Barras

En primer lugar, voy a comparar las diferentes tasas de suicidios de cada cluster.

# Reestructuramos los datos
df_melted <- melt(df_procesado, id.vars = "Cluster", measure.vars = c("Total", "Male", "Female"))

# Creamos la gráfica
ggplot(df_melted, aes(x = Cluster, y = value, fill = variable)) +
  geom_bar(stat = "summary", fun = "mean", position = "dodge") +
  labs(title = "Media por Cluster",
       x = "Cluster",
       y = "Media",
       fill = "Categoria") +
  theme_minimal()

Como se observa claramente en la gráfica anterior, el cluster 1 tiene una tasa de suicidios significativa mente mayor que en los otros dos, esto se ve reflejado tanto en el total, como en los masculinos y los femeninos. Con respecto a los otros dos cluster, el segundo tiene unas tasas de suicidios bastante bajas y el tercero unas tasas intermedias.

Boxplot

Para ver esto mismo, pero de otra manera voy a user las visualizaciones de cajas.

df_procesado %>%
  ggplot(aes(x = Cluster, y = Total, fill = Cluster)) +
  geom_boxplot() +
  labs(title = "Boxplots para cada Cluster", x = "Cluster", y = "Total") +
  theme_minimal() 

Esta visualización, a parte de reflejar lo mismo que he comentado antes, tambien permite ver la variación de cada cluster. Se puede observar incluso, que existe un outlier para el primer cluster.

Mapa mundial

La última representación que quiero realizar para responder a la pregunta incial, es ver la localicación de los paises de cada cluster.

Para ello, primero es necesario añadir una columna más al dataset que indique el código de cada pais para el estándar ISO3.

df_procesado$iso3 <- countrycode(df_procesado$GEO_NAME_SHORT, "country.name", "iso3c")

## Warning: Some values were not matched unambiguously: Africa, Americas, Eastern Mediterranean, Europe, High-income economies, Low-income economies, Lower-middle-income economies, South-East Asia, Upper-middle-income economies, Western Pacific, World

head(df_procesado)

## # A tibble: 6 × 6
##   GEO_NAME_SHORT Total  Male Female Cluster iso3 
##   <chr>          <dbl> <dbl>  <dbl> <fct>   <chr>
## 1 Afghanistan     4.68  5.06   3.98 2       AFG  
## 2 Africa          8.05 12.0    4.16 2       <NA> 
## 3 Albania         5.86  7.47   4.46 2       ALB  
## 4 Algeria         3.35  4.22   2.47 2       DZA  
## 5 Americas        8.48 13.3    3.81 2       <NA> 
## 6 Angola          7.21 12.1    3.19 2       AGO

Una vez creada esta columna, podemos mostrar el mapa del mundo con los paises de cada cluster representados por un color distinto.

# Crear el mapa interactivo con animación basada en el año
fig <- plot_geo(df_procesado, locations = ~iso3, color = ~Cluster, text = ~GEO_NAME_SHORT) %>%
  colorbar(title = "Cluster") %>%
  layout(title = 'Cluster',
         geo = list(showframe = FALSE, showcoastlines = TRUE, projection = list(type = 'natural earth')))

## No scattergeo mode specifed:
##   Setting the mode to markers
##   Read more about this attribute -> https://plotly.com/r/reference/#scatter-mode

## Warning: Didn't find a colorbar to modify.

# Mostrar el mapa
fig

Se observa que, a pesar de estar bastante repartidos, los paises del cluster 1 se encuentran en su mayor parte por la zona de Europa del Este y Rusia, mientras que los paises del cluster 2 se encuentran en su mayoría en África, Sudamérica y el sur de Asia, y, por último, los paises del tercer cluster están situados en su mayoría en Europa, Norte América y algunos puntos del sur de África y Asia.